home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE04 / RTCL / RTCL.ZIP / TESTUNIT.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1995-09-23  |  4.6 KB  |  161 lines
  1. {  Tomasz Stanczak                                                   }
  2. {  Hardenbergstr. 8                                                  }
  3. {  31275 Lehrte                                                      }
  4. {  Germany                                                           }
  5. {                                                                    }
  6. {  CIS ID: 100735,3273                                               }
  7.  
  8. unit TestUnit;
  9.  
  10. interface
  11.  
  12. uses
  13.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  14.   Forms, Dialogs, StdCtrls, Menus, RtChkLst, ExtCtrls;
  15.  
  16. type
  17.   TForm1 = class(TForm)
  18.     Memo1: TMemo;
  19.     ListBox1: TListBox;
  20.     Button2: TButton;
  21.     Button3: TButton;
  22.     Button4: TButton;
  23.     RtCheckList1: TRtCheckList;
  24.     Label1: TLabel;
  25.     Label2: TLabel;
  26.     RtCheckList2: TRtCheckList;
  27.     RtCheckList3: TRtCheckList;
  28.     Label3: TLabel;
  29.     Button1: TButton;
  30.     RadioGroup1: TRadioGroup;
  31.     procedure Button3Click(Sender: TObject);
  32.     procedure Button4Click(Sender: TObject);
  33.     procedure Button1Click(Sender: TObject);
  34.     procedure Button2Click(Sender: TObject);
  35.     procedure RtCheckList1Click(Sender: TObject);
  36.     procedure RtCheckList2Click(Sender: TObject);
  37.     procedure RtCheckList3Click(Sender: TObject);
  38.     procedure RadioGroup1Click(Sender: TObject);
  39.     procedure RtCheckList1Check(Sender: TObject; Index: Integer;
  40.       var Value: Boolean);
  41.     procedure RtCheckList3DrawItem(Sender: TObject; Index: Integer;
  42.       Rect: TRect; State: TOwnerDrawState; var Handled: Boolean);
  43.   private
  44.     { Private-Deklarationen }
  45.   public
  46.     { Public-Deklarationen }
  47.   end;
  48.  
  49. var
  50.   Form1: TForm1;
  51.  
  52. implementation
  53.  
  54. {$R *.DFM}
  55.  
  56. procedure TForm1.Button3Click(Sender: TObject);
  57. var
  58.    i: integer;
  59. begin
  60.    for i:=0 to Memo1.Lines.Count-1 do
  61.    begin
  62.       if RtCheckList1.Items.IndexOf(Memo1.Lines[i])<0 then
  63.          RtCheckList1.Items.Add(Memo1.Lines[i]);
  64.       if RtCheckList2.Items.IndexOf(Memo1.Lines[i])<0 then
  65.          RtCheckList2.Items.Add(Memo1.Lines[i]);
  66.       if RtCheckList3.Items.IndexOf(Memo1.Lines[i])<0 then
  67.          RtCheckList3.Items.Add(Memo1.Lines[i]);
  68.    end;
  69. end;
  70.  
  71. procedure TForm1.Button4Click(Sender: TObject);
  72. var
  73.    i,n: integer;
  74. begin
  75.    for i:=0 to Memo1.Lines.Count-1 do
  76.    begin
  77.       n := RtCheckList1.Items.IndexOf(Memo1.Lines[i]);
  78.       if n>=0 then
  79.          RtCheckList1.Items.Delete(n);
  80.       n := RtCheckList2.Items.IndexOf(Memo1.Lines[i]);
  81.       if n>=0 then
  82.          RtCheckList2.Items.Delete(n);
  83.       n := RtCheckList3.Items.IndexOf(Memo1.Lines[i]);
  84.       if n>=0 then
  85.          RtCheckList3.Items.Delete(n);
  86.    end;
  87. end;
  88.  
  89. procedure TForm1.Button1Click(Sender: TObject);
  90. var
  91.    i: integer;
  92. begin
  93.    for i:=0 to Memo1.Lines.Count-1 do
  94.    begin
  95.       RtCheckList1.Value[Memo1.Lines[i]] := True;
  96.       RtCheckList2.Value[Memo1.Lines[i]] := True;
  97.       RtCheckList3.Value[Memo1.Lines[i]] := True;
  98.    end;
  99. end;
  100.  
  101. procedure TForm1.Button2Click(Sender: TObject);
  102. var
  103.    i: integer;
  104. begin
  105.    for i:=0 to Memo1.Lines.Count-1 do
  106.    begin
  107.       RtCheckList1.Value[Memo1.Lines[i]] := False;
  108.       RtCheckList2.Value[Memo1.Lines[i]] := False;
  109.       RtCheckList3.Value[Memo1.Lines[i]] := False;
  110.    end;
  111. end;
  112.  
  113. procedure TForm1.RtCheckList1Click(Sender: TObject);
  114. begin
  115.     ListBox1.Items.Assign(RtCheckList1.Checked);
  116.     Label3.Caption := RtCheckList1.Name;
  117. end;
  118.  
  119. procedure TForm1.RtCheckList2Click(Sender: TObject);
  120. begin
  121.     ListBox1.Items.Assign(RtCheckList2.Checked);
  122.     Label3.Caption := RtCheckList2.Name;
  123. end;
  124.  
  125. procedure TForm1.RtCheckList3Click(Sender: TObject);
  126. begin
  127.     ListBox1.Items.Assign(RtCheckList3.Checked);
  128.     Label3.Caption := RtCheckList3.Name;
  129. end;
  130.  
  131. procedure TForm1.RadioGroup1Click(Sender: TObject);
  132. begin
  133.    RtCheckList1.CheckMode := TRtCheckMode(TRadioGroup(Sender).ItemIndex);
  134.    RtCheckList2.CheckMode := TRtCheckMode(TRadioGroup(Sender).ItemIndex);
  135.    RtCheckList3.CheckMode := TRtCheckMode(TRadioGroup(Sender).ItemIndex);
  136. end;
  137.  
  138. procedure TForm1.RtCheckList1Check(Sender: TObject; Index: Integer;
  139.   var Value: Boolean);
  140. var
  141.     Line: string;
  142. begin
  143.     Line := TRtCheckList(Sender).Items[Index]+' will be ';
  144.    if Value then
  145.        Line := Line+'checked.'
  146.    else
  147.        Line := Line+'unchecked.';
  148.     if MessageDlg(Line+#13#10+'Proceed ?',mtConfirmation,[mbYes,mbNo],0)=mrNo then
  149.        Value := not Value;
  150. end;
  151.  
  152. procedure TForm1.RtCheckList3DrawItem(Sender: TObject; Index: Integer;
  153.   Rect: TRect; State: TOwnerDrawState; var Handled: Boolean);
  154. begin
  155.       with TRtCheckList(Sender) do
  156.           if Value[Items[Index]] then
  157.            Canvas.Font.Color := clRed;
  158. end;
  159.  
  160. end.
  161.